perm filename QUADO.F4[MUS,LCS]1 blob sn#007369 filedate 1974-01-08 generic text, type T, neo UTF8
00100		SUBROUTINE QUADO(P,IPAR,NL,XF,YF)
00200		DIMENSION P(30),FAC(4)
00300		EQUIVALENCE(XA,FAC(1)),(XB,FAC(2)),(XC,FAC(3)),(XD,FAC(4))
00400		XC=0
00500		XD=0
00600		IF(NL.EQ.-14.OR.NL.EQ.-16)GO TO 1
00700	C   -14 OR -16=X,Y SYSTEM
00800		DG=AMOD(P(IPAR-4),360.0)
00900	C   DG=DEGREES
01000		DX=DG
01100		IF(DX.GT.90.AND.DX.LE.180)DX=180.-DX
01200	C   PUTS DX INTO UPPER QUADRANT
01300		IF(DX.GE.270.)DX=360.-DX
01400		IF(DX.GT.180.)DX=DX-180.
01500		DIS=P(IPAR-3)
01600	C   DIST. FROM CENTER OF CIRCLE
01700		XX=P(IPAR-2)
01800		YY=P(IPAR-1)
01900	C   XX,YY IS CENTER OF CIRCLE
02000		X=DIS*SIND(DX)
02100		Y=DIS*COSD(DX)
02400		IF(DG.GT.90.AND.DG.LT.270)Y=-Y
02500	C   BOTTOM HALF
02600		IF(DG.GT.180)X=-X
02700	C   LEFT HALF
02800		X=X+XX
02900		Y=Y+YY
02920		XF=X
02960		YF=Y
03000		GO TO 10
03100	
03200	1	X=P(IPAR-4)
03300		Y=P(IPAR-3)
03400		XF=X
03500		YF=Y
03550	C   XF AND YF SAVE COORDS FOR SHOWING PATH ON DPY.
03600	10	DIS=SQRT(X**2+Y**2)
03700	C   DIST. OF SOUND FROM LISTENER
03750		IQUAD=1
03800		S=X
03900		T=Y
04000		XX=ABS(X)
04100		YY=ABS(Y)
04200	C   NEXT FINDS QUADRANT
04300		IF(X.LT.YY)GO TO 7
04400		IQUAD=2
04500		S=-Y
04600		T=X
04700		GO TO 3
04800	7	IF(-Y.LT.XX)GO TO 8
04900		IQUAD=3
05000		S=-X
05100		T=-Y
05200		GO TO 3
05300	8	IF(-X.LE.YY)GO TO 3
05400		IQUAD=4
05500		S=Y
05600		T=-X
05700	3	XA=.5-S/(T*2)
05800		XB=1-XA
05900	C   % OF SNUND IN EACH "FRONT" SPEAKER
06000		IF(DIS.GE.14.14)GO TO 30
06100	C   OUTSIDE OF SPEAKER CIRCLE, THEN JUMP
06150	CC	X=1-DIS/14.14
06200		X=(1-DIS/14.14)**2
06300	C   FACTOR (OR TRY? (1-DIS/14.14)**2  )
06400		XA=XA+(1-XA)*X
06500		XB=XB+(1-XB)*X
06600		XC=XB*X
06700		XD=XA*X
06800	C   SUM OF FACTORS WILL BE FROM 1(AT EDGE) TO 4(AT CENTER)
06900		GO TO 31
07000	30	X=1-((DIS-14.14)/DIS)**2
07100	C   OUTSIDE CIRCLE (TRY ALSO SANS **)
07200		XA=XA*X
07300		XB=XB*X
07400	31	N=IPAR-5
07500		IQUAD=IQUAD-1
07600		DO 2 K=1,4
07700		J=IQUAD+K
07800		IF(J.GT.4)J=J-4
07900	2	P(J+N)=FAC(K)
08000	C  SETS DIR. SIG. MULTIPLIERS FOR EACH SPKR
08100		P(IPAR)=0
08200		RETURN
08300		END
08400	C   CAN BE USED FOR 2 CHANS.  BUT 5 PARAMS STILL NEEDED.